perm filename CONS[DIS,DBL] blob
sn#226051 filedate 1976-07-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 .ASEC(Concepts and Heuristics as coded in LISP)
C00031 ENDMK
C⊗;
.ASEC(Concepts and Heuristics as coded in LISP)
.CONS: ASECNUM ;
.BEGIN TURN ON "{}";
The reader may wish to inspect the actual LISP encoding of concepts and
their facets -- including heuristic rules. For that reason, a few pages
are excerpted from the AM program and shown below.
The facets of a concept are stored as properties on its property list.
Each facet has a rigid format that it must adhere to; that format varies
from facet to facet.
Two concepts have been selected: ⊗4Compose⊗*, which is larger than the typical
concept, and ⊗4Oset-structure⊗*, which is a smaller and simpler concept.
. ASSEC(The `Compose' Concept)
.TURN ON "{}";
Here is the property list of the atom "COMPOSE", when AM starts up.
The reader should look for (and find!) parallels between the
complete entries below and the abbreviated summaries on page {[3]COMPP}.
For that reason, after each entry, the corresponding summary line is repeated
(in a box).
.BEGIN NOFILL PREFACE 0; INDENT 0; SELECT 3; TURN OFF "@"; GROUP
⊗5↓_ENGN_↓⊗*$$ This is short for "English name", and is the facet called "Name(s)"
everywhere else in this thesis.$ (COMPOSE Compose Composition (Afterwards))
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Name(s): Compose, Composition, sometimes: afterwards; $
.EBOX
.APART;
⊗5↓_DEFN_↓⊗* (TYPE NEC&SUFF PC DECLARATIVE SLOW (FOREACH X IN (DOMAIN BA2)
RETURN (APPLYB$$
The function "APPLYB" indicates that a concept's facet is to be accessed and then
executed. (APPLYB C F x y...) means: access an entry on facet F of concept C,
and then run it on the arguments x,y,... $ BA1 ALGS (APPLYB BA2 ALGS X]
↓_DEFN-SUFF_↓ [[TYPE SUFFICIENT NONRECURSIVE QUICK
(AND (ISA BA1 'ACTIVE)
(ISA BA2 'ACTIVE)
(ISA BA3 'ACTIVE)
(ARE-EQUIV BA3 (ALREADY-COMPOSED$$
This LISP function checks to see whether the two operations have been composed
before. $ BA1 BA2]
[TYPE SUFFICIENT QUASIRECURSIVE SLOW (ARE-EQUIV BA3
(APPLYB 'COMPOSE 'ALGS BA1 BA2]$$ The arguments to Compose.Defn
(and to Compose.Algs as well) are called BA1, BA2,... Thus we would write
each definition of Compose as "λ (BA1 BA2 BA3) ..." $
[TYPE SUFFICIENT QUASIRECURSIVE QUICK (EQUAL BA3
(APPLYB 'COMPOSE 'ALGS BA1 BA2]]
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Definitions: $
MBOX Declarative slow: λ (A,B,C) ⊗6∀x, C(x)=A(B(x)⊗*. $
MBOX Sufficient Nonrecursive Quick: λ (A,B,C) C has the Name `A-o-B'. $
MBOX Sufficient, Slow: Are-equivalent(C,Compose.Algs(A,B)). $
MBOX Sufficient, Quick: C=Compose.Algs(A,B). $
.EBOX
.APART; GROUP;
⊗5↓_D-R_↓⊗* ((OPERATION ACTIVE OPERATION)
(RELATION RELATION RELATION)
(PREDICATE ACTIVE PREDICATE)
(ACTIVE ACTIVE ACTIVE))
↓_D-R-FILLIN1_↓ (PROGN (ARGS-ASA COMPOSE F1 F2) (CADAR (CON-MERGE-ARGS$$
This is a LISP function, opaque to AM, which analyzes the Domain/range facets
of the two operations F1 and F2, and sees how (if at all) the range of F1 can
be made to overlap the domain of F2. Note that F2 is applied AFTER F1.
The LISP code for this function is presented on page {[3]CONMERGEP}. $ F1 F2)))
↓_EXS-D-R-FILLIN1_↓ [PROGN (ARGS-ASA COMPOSE F1 F2)
[SETQ RAN1 (LAST (ANY1OF (GETB F1 'D-R] (* RAN1 is the range of F1)
[SETQ DOM1 (ALL-BUT-LAST (ANY1OF (GETB F1 'D-R]
[SETQ RAN2 (LAST (ANY1OF (GETB F2 'D-R] (* RAN2 is the range of F2)
[SETQ DOM2 (ALL-BUT-LAST (ANY1OF (GETB F2 'D-R]
[SETQ X (MAXIMAL RAN2 DOM1 'FRAC-OVERLAP]
(NCONC1 (LSUBST DOM2 for X in DOM1) RAN1]
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Domain/range: <Active Active α→ Active> $
MBOX <Operation Active α→ Operation> $
MBOX <Predicate Active α→ Predicate> $
MBOX <Relation Relation α→ Relation> $
MBOX Fillin: 2 ⊗4(out of a total of 9)⊗* heuristics. $
FBOX In Appendix {[2]ALLHEU}, these are heuristics numbers {[3]CDRH1} and {[3]CDRH2}. %
.EBOX
.APART;
⊗5↓_ALGS_↓⊗* ((TYPE QUASIRECURSIVE INDIRECT CASES [PROGN
(COND
((NULL BA1)
(APPLYB 'COMPOSE
'ALGS
(RAND-MEMB (EXS$$
The function "EXS" ripples outward from its argument, collecting examples as it
goes. $ ACTIVE))
BA2 BA3 BA4))$$ Note what this clause says: if Compose.Algs
is ever called with its first argument missing, randomly select an Active to
use as that constituent of the composition. $
&$$ Similar to last case: takes care of missing second argument.
The ampersand, "&", indicates an omission from this listing. $
((ALREADY-COMPOSED BA1 BA2) (* Note: this sets GTEMP12) GTEMP12)
((AND BA1 BA2 (IS-CON$$
An abbreviation for (APPLYB 'ANY-CONCEPT 'DEFN BA1); i.e., test whether BA1
is a bona fide concept or not. $ BA1)
(IS-CON BA2)
(ISA BA1 'ACTIVE)
(ISA BA2 'ACTIVE)
(SETQ GTEMP11 (CON-MERGE-ARGS BA1 BA2 GTEMP12)))
(* GTEMP12 is now the name of the new composition)
(CREATEB$$
CREATEB is a function which sets up a new blank data structure for a new concept.
$ GTEMP12)
[SETQ GUP1 (COND ((ISAG CS-B 'COMPOSE) CS-B) (T 'COMPOSE]
(* GUP1 is now the KIND of concept which GTEMP12 is to be an example of.
This will usually be "COMPOSE" or some variant of it. )
[INCRB$$
The function call (INCRB C F X) means: add entry X to the F facet of concept C.
$ GTEMP12 'DEFN
(LIST 'TYPE 'APPLICATION 'OF GUP1
(APPEND (LIST 'APPLYB (Q$$
The LISP function "Q" is like a double quote; after one evaluation
(Q X) returns 'X; after one more evaluation, 'X returns X; after
a final evaluation, we get the VALUE of X.
$ COMPOSE) (Q ALGS) (KWOTE BA1) (KWOTE BA2))
(FIRSTN (LENGTH (CAAR GTEMP11)) BA-LIST]
(* Another way to fill in an entry for GTEMP12.Defn)
(COND
([SETQ GTEMP308 (CAR (SOME (EXS COMPOSE)
(FUNCTION (LAMBDA (C)
(MEMBER (LASTELE (GETB GTEMP12 'DEFN))
(GETB (LASTELE C) 'DEFN]
(FORGET-CONCEPT GTEMP12)
(CPRIN1S 8 GTEMP12 turned out to be equivalent to GTEMP308 DCR)$$
A conditional print statement. If the verbosity level is high enough
(>8), this message is typed out to the user. Note the intermixing of
variables (e.g., "GTEMP308") and undefined atoms (e.g.,
"equivalent"). CPRIN1S examines each argument, and if it is
undefined, it quotes it. $
GTEMP308)
(T (INCRB GUP1 'EXS (NCONC1 (GEARGS GUP1) GTEMP12))
[SOME (RIPPLE GUP1 'GENL)
(FUNCTION (LAMBDA (G)
(SOME (GETB G 'D-R)
(FUNCTION (LAMBDA (D)
(AND (ISA BA1 (CAR D))
(ISA BA2 (CADR D))
(INCRB GTEMP12 'UP$$ The ISA's facet
is called "UP" in the LISP program. $ (CADDR D))
(INCRB (CADDR D) 'EXS GTEMP12]
(* This last INCRB says that if an operation f maps onto range C,
and we apply f and get a new Being, then that Being ISA C)$$ This
is
a streamlined, specialized version of the more general
heuristic rule number {[3]GETRR}; see page {[3]GETRRP}. $
(INCRB GTEMP12 'IN-RAN-OF GUP1)
(INCRB BA2 'IN-DOM-OF GUP1)
(INCRB BA1 'IN-DOM-OF GUP1)
(* Now see if the composition GTEMP12 shares any ISA's entries with
either constituent operation: BA1 or BA2)$$
This next MAPC is thus the LISP encoding of heuristic rule number {[3]ISARG};
see page {[3]ISARGP}. $
.ISARGP2: PAGE;
[MAPC [INTERSECTION (SET-DIFF [UNION (GETB BA1 'UP) (GETB BA2 'UP]
(GETB GTEMP12 'UP]
(FUNCTION (LAMBDA (Z)
(COND
((DEFN Z GTEMP12)
(INCRB Z 'EXS GTEMP12)
(INCRB GTEMP12 'UP Z]
(COND
[(GETB GTEMP12 'UP)
(SETB GTEMP12 'GUP (COPY (GETB GTEMP12 'UP]
(T (INCRB GTEMP12 'UP 'OPERATION)
(INCRB 'OPERATION 'EXS GTEMP12)))
& (* A similar search now for GENL/SPEC of the composition)
(SETB GTEMP12 'D-R (CAR GTEMP11))
(INCRB GTEMP12 'ALGS
(LIST 'TYPE 'NONRECURSIVE 'APPLICATION 'OF GUP1 (CADR GTEMP11)))
& (* Code for synthesizing a Defn entry for GTEMP12)
(SETB GTEMP12 'WORTH
(MAP2CAR (GETB BA1 'WORTH) (GETB BA2 'WORTH) 'TIMES1000))
(GS-CHECK$$
This is a general-purpose function for testing that there is no hidden
cycle in the Generalization network, that no two concepts are both
generalizations and specializations of each other, unless they are tagged
as being equivalent to each other. $ GTEMP12]]))]
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Algorithms: $
MBOX Distributed: use the heuristics attached to Compose to guide the filling $
MBOX in of various facets of the new composition. $
FBOX (The heuristics referred to are shown in Appendix {[3]ALLHEU}.{[3]COMPH}, on page {[3]COMPHP}.) %
MBOX Fillin: 5 ⊗4(out of a total of 9)⊗* heuristics. $
MBOX Check: 1 heuristic ⊗4(out of a total of 2)⊗* $
.EBOX
.APART; GROUP;
⊗5↓_UP_↓⊗* (OPERATION)
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Isa's: Operation $
.EBOX
.APART; GROUP;
⊗5↓_WORTH_↓⊗* (300)
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Worth: 300 $
.EBOX
.APART
⊗5↓_INT_↓⊗*$$
Note that although the Fillin and Suggest heuristics are blended into the
relevant facets (e.g., into the Algorithms for COMPOSE), the INTERESTINGNESS
type heuristics are kept separate, in this facet. $ [(IMATRIX (1 2 3) (4 5))
(COND [(INTERSECTION (MAPAPPEND (GETB BA2 'D-R) 'LAST)
(MAPAPPEND (GETB BA1 'D-R) 'ALL-BUT-LAST))
300
(IDIFF 400 (ITIMES 100 (IPLUS (LENGTH (GETB BA1 'D-R))
(LENGTH (GETB BA2 'D-R]
(REASON (* In some interpretation, Range-of-op2 is 1 component of Domain-of-op1)))
(COND [[MEMB [CAR (LAST (CAR (GETB BA2 'D-R]
(ALL-BUT-LAST (CAR (GETB BA1 'D-R]
400
(IDIFF 1000 (ITIMES 100 (LENGTH (CAR (GETB BA1 'D-R]
(REASON (* In canonical interpretation, Range-of-op2 is a component of Domain of op1)))
(COND [(INTERSECTION (GETB CS-B TIES)
(UNION (GETB BA1 TIES)(GETB BA2 TIES)))
100
(ITIMES 100 [LENGTH (INTERSECTION (GETB CS-B TIES)
(UNION (GETB BA1 TIES)(GETB BA2 TIES])
(REASON (* This composition preserves some good properties of its constituents))])
(COND [(SET-DIFFERENCE (GETB CS-B TIES)
(UNION (GETB BA1 TIES)(GETB BA2 TIES)))
100
(ITIMES 100 [LENGTH (SET-DIFFERENCE (GETB CS-B TIES)
(UNION (GETB BA1 TIES)(GETB BA2 TIES])
(REASON (* This composition has some new props, not true of either constituent))])
(COND [(OR (GREATERP (GETB BA1 'WORTH) 500))
(GREATERP (GETB BA2 'WORTH) 500)))
300
(IQUOTIENT (ITIMES (GETB BA1 'WORTH)(GETB BA2 'WORTH))
1000)
(REASON (* Op1 and/or Op2 are very interesting themselves))])
(COND [[IS-ONE-OF [CAR (LAST (CAR (GETB BA2 'D-R]
(ALL-BUT-LAST (CAR (GETB BA1 'D-R]
350
(IDIFF [ITIMES 100 (IDIFF
[LENGTH (CAR (GETB BA1 'D-R]
(LENGTH (RIPPLE [IS-ONE-OF
[SETQ TMP4 (CAR (LAST (GETB BA2 'D-R]
(ALL-BUT-LAST (CAR (GETB BA1 'D-R]
'GENL]
(ITIMES 50 (LENGTH (RIPPLE TMP4 'GENL]
(REASON (* In canonical interpretation, Range-of-op2 is a specialization of a component
of Domain-of-op1)))
(COND [[MEMB [CAR (LAST (CAR (GETB BA1 'D-R]
(ALL-BUT-LAST (CAR (GETB BA2 'D-R]
450
(IPLUS 300 (COND ([MEMB [CAR (LAST (CAR (GETB BA1 'D-R]
(ALL-BUT-LAST (CAR (GETB BA1 'D-R]
10)
(T 250))
(COND ([MEMB [CAR (LAST (CAR (GETB BA2 'D-R]
(ALL-BUT-LAST (CAR (GETB BA2 'D-R]
11)
(T 250))
(ITIMES 70 (LENGTH (RIPPLE [CAR (LAST (CAR (GETB BA1 'D-R] 'GENL]
(REASON (* In canonical interpretation,
Range-of-op1 is one component of Domain-of-op2))
&
(COND [[ISA [CAR (LAST (CAR (GETB BA1 'D-R]
(ALL-BUT-LAST (CAR (GETB BA2 'D-R]
250
(IPLUS 50 (COND ([ISA [CAR (LAST (CAR (GETB BA1 'D-R]
(ALL-BUT-LAST (CAR (GETB BA1 'D-R]
10)
(T 100))
(COND ([ISA [CAR (LAST (CAR (GETB BA2 'D-R]
(ALL-BUT-LAST (CAR (GETB BA2 'D-R]
11)
(T 100))
(ITIMES 50 (LENGTH (RIPPLE [CAR (LAST (CAR (GETB BA1 'D-R] 'GENL]
(REASON (* Range-of-op1 is a specialization of a component of Domain-of-op2]
⊗4Appearance on page {[3]COMPP}:⊗*
.WBOX(8,8)
MBOX Interest: 11 heuristics. $
FBOX The heuristic rules encoded above are shown in English on page {[3]COMI}. %
.EBOX
.TURN ON "∞→"; SELECT 8
∞≡→
⊗4Here is the code for CON-MERGE-ARGS, the function which decides how to overlap
the domain/range facets of its two arguments, F1 and F2:⊗*
.SELECT 7; CONMERGEP: PAGE;
(CON-MERGE-ARGS
[LAMBDA (F1 F2 F12 PGM1 SCHK SAPL DOM1 DOM2 RAN1 RAN2 TIL DOM3)
[SETQ RAN1 (LAST (CAR (GETB F1 'D-R]
(SETQ DOM1 (LDIFF (CAR (GETB F1 'D-R))
RAN1))
[SETQ RAN2 (LAST (CAR (GETB F2 'D-R]
(SETQ DOM2 (LDIFF (CAR (GETB F2 'D-R))
RAN2))
[SETQ DOM3 (AND (CDR DOM1)
(LIST (CADR (MIN2 (APPEND RAN2 RAN2 RAN2
RAN2) DOM1 'FRAC-OVERLAP]
(* As DOMi and RANi are located, Switching of Args may be required, inside PGM1)
(AND (MEMB (CAR DOM3) DOM2) (SETQ DOM3 NIL))
(SETQ GTEMP20 (LENGTH DOM2))
[SETQ SAPL (NCONC (LIST 'APPLYB (KWOTE F1) (Q ALGS))
(MAPCAR (SUB-ONCE 'X
[SETQ GTEMP19 (COND
((IS-ONE-OF (CAR RAN2) DOM1))
[(SETQ SCHK (ONE-ISAG DOM1 (CAR RAN2]
((SETQ SCHK (AND (SETQ TIL (EXS (CAR RAN2))
(CAR (SOME DOM1 (FUNCTION (LAMBDA (D)
(INTERSECTION
TIL
(EXS D]
DOM1)
(FUNCTION (LAMBDA (Z)
(COND
((EQ Z 'X)
'X)
(T (SETQ GTEMP20 (ADD1 GTEMP20))
(CAR (FNTH BA-LIST GTEMP20]
(* SCHK is a flag which means that f2 maps us into an element of RAN2 which is not guaranteed
a priori to be an element of DOM1, hence a check for this applicability of f1 will then have to be made)
(COND
((FMEMB 'X SAPL)
(SETQ DOM3 (REM-ONCE GTEMP19 DOM1))
(SETQ GTEMP7 (APPEND DOM3 DOM2))
[COND
[(NEQ (LENGTH GTEMP7)
(LENGTH (SELF-INT GTEMP7)))
(CPRIN1S 9 CRLF CRLF AM can later coalesce the D-R of F12 DCR)
[ADD-CANDS (LIST (LIST (LIST 'APPLYB (Q COALESCE) (Q ALGS) (KWOTE F12))
(IPLUS 100 (IQUO (DOTPROD (FIRSTN 2 (GETB F1 'WORTH))
(GETB F2 'WORTH)) 2000))
(LIST (SPLIST There is an overlap in the new combined
domain of the operation F12]
(SWHY 9 (There is an obvious overlap in (@ GTEMP7),the new combined domain of (@ F12]
⊗4The next piece of this function is the heuristic rule numbered {[3]COAC} in Appendix {[2]ALLHEU}.⊗*
([SOME GTEMP7 (FUNCTION (LAMBDA (X)
(IS-ONE-OF X (CDR (FMEMB X GTEMP7]
(CPRIN1S 10 CRLF CRLF AM may later coalesce the D-R of F12 DCR)
[ADD-CANDS (LIST (LIST (LIST 'APPLYB (Q COALESCE) (Q ALGS) (KWOTE F12))
(IQUO (DOTPROD (FIRSTN 2 (GETB F1 'WORTH))
(GETB F2 'WORTH)) 2500))
(LIST (SPLIST There may be an overlap
in the new combined domain of the operation F12]
(SWHY 10 (There is a subtle overlap in (@ GTEMP7),the new combined domain of (@ F12]
[SETQ PGM1 (LIST 'PROG
(LIST 'X)
[LIST 'SETQ 'X
(NCONC (LIST 'APPLYB (KWOTE F2) (Q ALGS))
(FIRSTN (LENGTH DOM2) (LIST 'BA1 'BA2 'BA3]
(LIST 'RETURN
(COND
(SCHK (LIST 'AND
(LIST 'APPLY* (Q DEFN) (KWOTE SCHK) 'X)
SAPL))
(T (LIST 'AND 'X SAPL]
(LIST (LIST (APPEND DOM2 DOM3 RAN1)) PGM1))
(T (* Composing is not possible) NIL])
.E
<<Should there be more explanation of the bits of this code? >
.SELECT 1;
. ASSECP(The `Osets' Concept)
Here is the actual property list of the data-structure corresponding to the
Osets concept:
.TURN ON "{}";
.BEGIN NOFILL PREFACE 0; INDENT 0; SELECT 3; TURN OFF "@"; GROUP;
⊗5↓_ENGN_↓⊗* (OSET Oset Oset-structure OSET-STRUC, Ordered-set (Set))
⊗5↓_DEFN_↓⊗* (TYPE NEC&SUFF RECURSIVE TRANSPARENT [COND
((EQUAL BA1 (OSET )) T)
(T (APPLYB 'OSET 'DEFN (APPLYB 'OSET-DELETE 'ALGS
(APPLYB 'SOME-MEMB 'ALGS BA1)
BA1])
(TYPE NEC&SUFF RECURSIVE QUICK [COND
((EQUAL BA1 '(OSET )) T)
((CDDR BA1) (APPLYB 'OSET 'DEFN (RPLACD BA1 (CDDR BA1)))
(T NIL])
(TYPE NEC&SUFF NONRECURSIVE QUICK (MATCH BA1 WITH ('OSET $)))
⊗5↓_GENL_↓⊗* (ORD-STRUC NO-MULT-ELES-STRUC)
⊗5↓_WORTH_↓⊗* (400)
⊗5↓_IN-DOM-OF_↓⊗* (OSET-JOIN OSET-INTERSECT OSET-DIFF OSET-INSERT OSET-DELETE)
⊗5↓_IN-RAN-OF_↓⊗* (OSET-JOIN OSET-INTERSECT OSET-DIFF OSET-INSERT OSET-DELETE)
⊗5↓_VIEW_↓⊗* (STRUCTURE (RPLACA BA1 'OSET))
.ES;
Compare this with the
way that the "Osets" concept appeared, on page {[3]OSETCP} of
Appendix {[3]ALLCON}:
.GROUP SKIP 1; WBOX(8,8);
MBOX Name(s): Oset, Oset-structure, Ordered-set, sometimes: Set. $
MBOX Definitions: $
MBOX Recursive: λ (S) (S=[ ] or Oset.Definition(Oset-Delete.Alg(Member.Alg(S),S))) $
MBOX Recursive quick: λ (S) (S=[ ] or Oset.Definition (CDR(S))) $
MBOX Quick: λ (S) (Match S with [...] ) $
MBOX Generalizations: Ordered-Structure, No-multiple-elements-Structure $
MBOX Worth: 400 $
MBOX In-domain-of: Oset-union, Oset-intersect, Oset-difference, Oset-insert, Oset-delete $
MBOX In-range-of: Oset-union, Oset-intersect, Oset-difference, Oset-insert, Oset-delete $
MBOX View: To view any structure as a Oset, do: λ (x) Enclose-in-square-brackets(x) $
.EBOX
.E